home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / btr_oop.exe / BTRV.PAS < prev    next >
Pascal/Delphi Source File  |  1991-05-26  |  7KB  |  213 lines
  1. UNIT BTRV;
  2.  
  3. INTERFACE
  4.  
  5. USES DOS,OBJECTS;
  6.  
  7.  
  8. Type
  9.   { This the first ancestor btrieve object. It is basically just the }
  10.   { original TP5BTRV.PAS shipped by novell with an object wrapper.   }
  11.   { The position block is made internal to the object so it doesn't  }
  12.   { need to be referenced with each Btrieve call.                    }
  13.  
  14.  
  15.   PBtrieve = ^TBtrieve;
  16.   TBtrieve = object(TObject)
  17.     Pos : array[1..128] of char;                        { Position block }
  18.     Constructor Init;
  19.     Destructor Done; Virtual;
  20.     Function Btrv (OP:Integer;
  21.                    Var Data; Var Datalen: integer;
  22.                    Var KBuf; Key: Integer): Integer;
  23.   end;
  24.  
  25. IMPLEMENTATION
  26.  
  27. {---------------------- TBtrieve Ancestor Object-------------------------------}
  28.  
  29. {$R-}     {Range checking off}
  30. {$B+}     {Boolean complete evaluation on}
  31. {$S+}     {Stack checking on}
  32. {$I+}     {I/O checking on}
  33.  
  34. {                                          }
  35. {  Module Name: BTRV.PAS                                                   }
  36. {                                          }
  37. {  Notes on converstion to object:                                            }
  38. {    The Position block parameter can be turned into a field in the object    }
  39. {    since each instance can now keep track of the position block internally. }
  40. {                                                                             }
  41. {                                                                             }
  42. {  Description: This is the Btrieve interface for Turbo Pascal (MS-DOS).      }
  43. {        This routine sets up the parameter block expected by          }
  44. {        Btrieve, and issues interrupt 7B.  It should be compiled      }
  45. {        with the $V- switch so that runtime checks will not be          }
  46. {        performed on the variable parameters.                  }
  47. {                                          }
  48. {  Synopsis:    STAT := BTRV (OP, POS.START, DATA.START, DATALEN,          }
  49. {                 KBUF.START, KEY);                  }
  50. {                  where                          }
  51. {            OP is an integer,                      }
  52. {            POS is a 128 byte array,                  }
  53. {            DATA is an untyped parameter for the data buffer,     }
  54. {            DATALEN is the integer length of the data buffer,     }
  55. {            KBUF is the untyped parameter for the key buffer,     }
  56. {            and KEY is an integer.                      }
  57. {                                          }
  58. {  Returns:    Btrieve status code (see Appendix B of the Btrieve Manual).   }
  59. {                                          }
  60. {  Note:    The Btrieve manual states that the 2nd, 3rd, and 5th          }
  61. {        parameters be declared as variant records, with an integer    }
  62. {        type as one of the variants (used only for Btrieve calls),    }
  63. {        as is shown in the example below.  This is supported, but     }
  64. {        the restriction is no longer necessary.  In other words, any  }
  65. {        variable can be sent in those spots as long as the variable   }
  66. {        uses the correct amount of memory so Btrieve does not          }
  67. {        overwrite other variables.                      }
  68. {                                          }
  69. {           var DATA = record case boolean of                  }
  70. {              FALSE: ( START: integer );                  }
  71. {              TRUE:  ( EMPLOYEE_ID: 0..99999;                  }
  72. {                   EMPLOYEE_NAME: packed array[1..50] of char;    }
  73. {                   SALARY: real;                      }
  74. {                   DATA_OF_HIRE: DATE_TYPE );              }
  75. {              end;                              }
  76. {                                          }
  77. {        There should NEVER be any string variables declared in the    }
  78. {        data or key records, because strings store an extra byte for  }
  79. {        the length, which affects the total size of the record.       }
  80. {                                          }
  81. {                                          }
  82.  
  83.  
  84. function TBtrieve.Btrv (OP:integer;
  85.                     var DATA;
  86.                     var DATALEN: integer;
  87.                 var KBUF;
  88.                         KEY: integer): integer;
  89.  
  90. const
  91.      VAR_ID        = $6176;        {id for variable length records - 'va'}
  92.      BTR_INT        = $7B;
  93.      BTR2_INT        = $2F;
  94.      BTR_OFFSET     = $0033;
  95.      MULTI_FUNCTION    = $AB;
  96.  
  97. {  ProcId is used for communicating with the Multi Tasking Version of          }
  98. {  Btrieve. It contains the process id returned from BMulti and should          }
  99. {  not be changed once it has been set.                       }
  100. {                                          }
  101.      ProcId: integer = 0;            { initialize to no process id }
  102.      MULTI: boolean = false;            { set to true if BMulti is loaded }
  103.      VSet: boolean = false;      { set to true if we have checked for BMulti }
  104.  
  105. type
  106.      ADDR32 = record                           {32 bit address}
  107.     OFFSET: word;                          {&&&old->integer}
  108.     SEGMENT: word;                         {&&&used->integer}
  109.      end;
  110.  
  111.      BTR_PARMS = record
  112.     USER_BUF_ADDR: ADDR32;                  {data buffer address}
  113.     USER_BUF_LEN: integer;                   {data buffer length}
  114.     USER_CUR_ADDR: ADDR32;                   {currency block address}
  115.     USER_FCB_ADDR: ADDR32;               {file control block address}
  116.     USER_FUNCTION: integer;                 {Btrieve operation}
  117.     USER_KEY_ADDR: ADDR32;                   {key buffer address}
  118.     USER_KEY_LENGTH: BYTE;                    {key buffer length}
  119.     USER_KEY_NUMBER: shortint;               {key number&&&old->BYTE}
  120.     USER_STAT_ADDR: ADDR32;             {return status address}
  121.     XFACE_ID: integer;                {language interface id}
  122.      end;
  123.  
  124. var
  125.      STAT: integer;                     {Btrieve status code}
  126.      XDATA: BTR_PARMS;                     {Btrieve parameter block}
  127.      REGS: Dos.Registers;      {register structure used on interrrupt call}
  128.      FINISHED: boolean;
  129.  
  130. begin
  131.      REGS.AX := $3500 + BTR_INT;
  132.      INTR ($21, REGS);
  133.      if (REGS.BX <> BTR_OFFSET) then          {make sure Btrieve is installed}
  134.     STAT := 20
  135.      else
  136.     begin
  137.        if (not VSet) then    {if we haven't checked for Multi-User version}
  138.           begin
  139.          REGS.AX := $3000;
  140.          INTR ($21, REGS);
  141.          if ((REGS.AX AND $00FF) >= 3) then
  142.             begin
  143.                VSet := true;
  144.                REGS.AX := MULTI_FUNCTION * 256;
  145.                INTR (BTR2_INT, REGS);
  146.                MULTI := ((REGS.AX AND $00FF) = $004D);
  147.             end
  148.          else
  149.             MULTI := false;
  150.           end;
  151.                             {make normal btrieve call}
  152.        with XDATA do
  153.           begin
  154.          USER_BUF_ADDR.SEGMENT := SEG (DATA);
  155.          USER_BUF_ADDR.OFFSET := OFS (DATA); {set data buffer address}
  156.          USER_BUF_LEN := DATALEN;
  157.          USER_FCB_ADDR.SEGMENT := SEG (POS);
  158.          USER_FCB_ADDR.OFFSET := OFS (POS);         {set FCB address}
  159.          USER_CUR_ADDR.SEGMENT := USER_FCB_ADDR.SEGMENT; {set cur seg}
  160.          USER_CUR_ADDR.OFFSET := USER_FCB_ADDR.OFFSET+38;{set cur ofs}
  161.          USER_FUNCTION := OP;          {set Btrieve operation code}
  162.          USER_KEY_ADDR.SEGMENT := SEG (KBUF);
  163.          USER_KEY_ADDR.OFFSET := OFS (KBUF);  {set key buffer address}
  164.          USER_KEY_LENGTH := 255;         {assume its large enough}
  165.          USER_KEY_NUMBER := KEY;              {set key number}
  166.          USER_STAT_ADDR.SEGMENT := SEG (STAT);
  167.          USER_STAT_ADDR.OFFSET := OFS (STAT);      {set status address}
  168.          XFACE_ID := VAR_ID;                 {set lamguage id}
  169.           end;
  170.  
  171.        REGS.DX := OFS (XDATA);
  172.        REGS.DS := SEG (XDATA);
  173.  
  174.        if (NOT MULTI) then             {MultiUser version not installed}
  175.           INTR (BTR_INT, REGS)
  176.        else
  177.           begin
  178.          FINISHED := FALSE;
  179.          repeat
  180.             REGS.BX := ProcId;
  181.             REGS.AX := 1;
  182.             if (REGS.BX <> 0) then
  183.                REGS.AX := 2;
  184.             REGS.AX := REGS.AX + (MULTI_FUNCTION * 256);
  185.             INTR (BTR2_INT, REGS);
  186.             if ((REGS.AX AND $00FF) = 0) then
  187.                FINISHED := TRUE
  188.             else begin
  189.                REGS.AX := $0200;
  190.                INTR ($7F, REGS);
  191.                FINISHED := FALSE;
  192.             end;
  193.          until (FINISHED);
  194.          if (ProcId = 0) then
  195.             ProcId := REGS.BX;
  196.           end;
  197.        DATALEN := XDATA.USER_BUF_LEN;
  198.     end;
  199.      BTRV := STAT;
  200. end;
  201. {$B-}
  202.  
  203. Constructor TBtrieve.Init;
  204. begin
  205. end;
  206.  
  207. Destructor TBtrieve.Done;
  208. begin
  209. end;
  210.  
  211. END.
  212.  
  213.